;; -*- emacs-lisp -*-

(defvar eip-cua-drag-last-mark-overlay nil)

(defvar eip-cua-drag-last-mark nil)

(defvar eip-cua-drag-old-mark-face 'region)

(defun eip-mouse-drag-in-mark (pt start end)
  (and (>= pt start)
       (< pt end)))

(defun eip-mouse-drag-store-mark (event)
  (if (and mark-active (not deactivate-mark) (eventp event))
      (let ((posn (event-start event))
	    pt in-region start-point end-point)
	(setq pt (posn-point posn))
	(if (> (point) (mark t))
	    (setq start-point (mark t) end-point (point))
	  (setq start-point (point) end-point (mark t)))
	(setq in-region (eip-mouse-drag-in-mark pt start-point end-point))
	(if in-region
	    (progn
	      (setq eip-cua-drag-last-mark (cons start-point end-point))
	      (setq eip-cua-drag-last-mark-overlay
		    (make-overlay start-point end-point (current-buffer)))
	      (overlay-put eip-cua-drag-last-mark-overlay 'face eip-cua-drag-old-mark-face)
	      )
	  nil))
    nil))

(defun eip-mouse-drag-region-to-paste (start-event)
  (interactive "e")
  (eip-mouse-drag-region-to start-event t))

(defun eip-mouse-drag-region-to (start-event &optional as-kill)
  (interactive "e")
  (let ((w (posn-window (event-start start-event))))
    (if (and (window-minibuffer-p w)
             (not (minibuffer-window-active-p w)))
	(mouse-drag-region start-event)
      (if (not (eip-mouse-drag-store-mark start-event))
	  (mouse-drag-region start-event)
	;(print eip-cua-drag-last-mark)
	(run-hooks 'mouse-leave-buffer-hook)
	;(mouse-set-point start-event)
	(setq mark-active nil)
	(eip-mouse-drag-track start-event t as-kill)))))

(defun eip-mouse-drag-track (start-event &optional
					 do-mouse-drag-region-post-process
					 &optional as-kill)
  (mouse-minibuffer-check start-event)
;  (print (car (cdr eip-cua-drag-last-mark)))
  (let* ((original-window (selected-window))
	 (selected-buffer (window-buffer original-window))
	 (start-posn (event-start start-event))
	 (start-point (posn-point start-posn))
	 (start-window (posn-window start-posn))
	 (start-window-start (window-start start-window))
	 (start-hscroll (window-hscroll start-window))
	 (bounds (window-edges start-window))
	 (make-cursor-line-fully-visible nil)
	 (top (nth 1 bounds))
	 (bottom (if (window-minibuffer-p start-window)
		     (nth 3 bounds)
		   ;; Don't count the mode line.
		   (1- (nth 3 bounds))))
;; 	 (on-link (and mouse-1-click-follows-link
;; 		       (or mouse-1-click-in-non-selected-windows
;; 			   (eq start-window original-window))
;;                        ;; Use start-point before the intangibility
;;                        ;; treatment, in case we click on a link inside an
;;                        ;; intangible text.
;;                        (mouse-on-link-p start-posn)))
;; 	 (click-count (1- (event-click-count start-event)))
;; 	 (remap-double-click (and on-link
;; 				  (eq mouse-1-click-follows-link 'double)
;; 				  (= click-count 1)))
	 ;; Suppress automatic hscrolling, because that is a nuisance
	 ;; when setting point near the right fringe (but see below).
	 ;(automatic-hscrolling-saved automatic-hscrolling)
	 ;(automatic-hscrolling nil)
	
	event pt)
    (track-mouse
      (while (progn
	       (setq event (read-event))
	       (or (mouse-movement-p event)
		   (memq (car-safe event) '(switch-frame select-window))))
	(if (memq (car-safe event) '(switch-frame select-window))
	    nil
	  (let* ((over-posn (event-start event))
		 (over-window (if over-posn
				  (posn-window over-posn)
				nil))
		 (over-buffer (if (window-live-p over-window)
				  (window-buffer over-window)
				nil))
		 )
	    ;(prin1 over-window)
	    (if (and (mouse-movement-p event) (eq over-buffer selected-buffer))
		(progn
		  (select-window over-window)
		  (setq pt (posn-point (event-start event)))
		  (if (integer-or-marker-p pt)
		      (goto-char (posn-point (event-start event)))))
	      (let ((mouse-row (cdr (cdr (mouse-position)))))
                (cond
                 ((null mouse-row))
                 ((< mouse-row top)
                  (mouse-scroll-subr start-window (- mouse-row top)))
                                     ;mouse-drag-overlay start-point))
                 ((>= mouse-row bottom)
                  (mouse-scroll-subr start-window (1+ (- mouse-row bottom))))
                                     ;mouse-drag-overlay start-point))
		  ))))))
      (delete-overlay eip-cua-drag-last-mark-overlay)
      (if (and do-mouse-drag-region-post-process
	       (not (eip-mouse-drag-in-mark
		     (point)
		     (car eip-cua-drag-last-mark)
		     (cdr eip-cua-drag-last-mark))))
	  (progn
	    (if as-kill
		(copy-region-as-kill (car eip-cua-drag-last-mark) (cdr eip-cua-drag-last-mark))
	      (kill-region (car eip-cua-drag-last-mark) (cdr eip-cua-drag-last-mark)))
	    (yank)
	    )
	)
      )))

(defun eip-mouse-popup-menu (event prefix)
  (interactive "@e \nP")
  (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
  (popup-menu menu-bar-edit-menu event prefix))

(define-key cua--region-keymap [remap mouse-drag-region] 'eip-mouse-drag-region-to)
(define-key cua--region-keymap [remap mouse-buffer-menu] 'eip-mouse-drag-region-to-paste)
(define-key cua--region-keymap [remap yank] 'cua-paste)
;(define-key cua--region-keymap [remap x-clipboard-yank] 'eip-x-clipboard-yank)
(defalias 'x-clipboard-yank 'cua-paste)
;(define-key cua--region-keymap (kbd "<mouse-3>") 'eip-mouse-popup-menu)
(global-set-key (kbd "<mouse-3>") 'eip-mouse-popup-menu)

(provide 'eip_cua_drag_ex)
